home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / Map / Map.p < prev    next >
Text File  |  1997-04-19  |  12KB  |  477 lines
  1. program Map;
  2.  
  3.     uses
  4. {$IFC UNDEFINED THINK_PASCAL}
  5.         Types, QuickDraw, Menus, ToolUtils, Resources, {}
  6.         SegLoad, Events, Processes, Windows, Dialogs,
  7. {$ELSEC}
  8. {$ENDC}
  9.         QDOffScreen, Palettes, TransSkel;
  10.  
  11.     const
  12.         kMaxAngle = 360 * 4; {NOT angle, but number of pixels wide! 360*2 is ok on 68k}
  13.         kFixedDigits = 8;
  14.         kFixedOne = 256; {2 ** kFixedDigits}
  15.         kFixedHalf = kFixedOne div 2;
  16.         kIntMask = $ffffff00;
  17.         kSignMask = $ff000000;
  18.         kAngle30 = kMaxAngle div 12;
  19.         kAngle60 = kMaxAngle div 6;
  20.         kAngle90 = kMaxAngle div 4;
  21.         kAngle120 = kMaxAngle div 3;
  22.         kAngle180 = kMaxAngle div 2;
  23.         kAngle15 = kMaxAngle div 24;
  24.         kAngle10 = kMaxAngle div 60;
  25.         kAngle5 = kMaxAngle div 72;
  26.  
  27.         kViewAngle = kMaxAngle div 8; {8}
  28.         kFullView = Longint(kViewAngle) * 2;
  29.  
  30.         kMaxRows = 200;
  31.         kHalfRows = kMaxRows div 2 * 0;
  32.         kMaxRay1 = 20;    {How far with step 1?}
  33.         kMaxRay2 = 40;    {How far with step 2?}
  34.         kMaxRay = 80;    {How far with step the rest (step 4)?}
  35.  
  36.         kMapSizeH = 256;
  37.         kMapSizeV = 256;
  38.  
  39.         kMapMaskH = kMapSizeH - 1;        {For BitAnd with coordinates!}
  40.         kMapMaskV = kMapSizeV - 1;
  41.  
  42.         kMapSizeFixedH = kMapSizeH * kFixedOne;
  43.         kMapSizeFixedV = kMapSizeV * kFixedOne;
  44.         kMapMaskFixedH = kMapSizeFixedH - 1;        {For BitAnd with coordinates!}
  45.         kMapMaskFixedV = kMapSizeFixedV - 1;
  46.  
  47.     var
  48.         m: MenuHandle;
  49.         dummy: Boolean;
  50.         r: Rect;
  51.         w: WindowPtr;
  52.         gOffscreen: GrafPtr;
  53.  
  54.     var
  55.         playerX, playerY, playerZ: Longint;
  56.         direction: Longint;
  57.         sinTable, cosTable: array[0..kMaxAngle] of Longint;
  58.  
  59.     type
  60.         ByteArr = packed array[0..99999] of Byte;
  61.         ByteArrPtr = ^ByteArr;
  62.     var
  63.         map, colorScreen: GrafPtr;
  64.         offscreenPixels, mapPixels, colorPixels: ByteArrPtr;
  65.         offscreenRow, mapRow, colorRow: Longint;
  66.         boundsRect, mapBoundsRect: Rect;
  67.  
  68.         c: RGBColor;
  69.         col: Integer;
  70.  
  71.     var
  72.         rowTable, dyTable: array[0..kMaxRows] of Longint;
  73.         mapRowTable: array[0..kMapSizeV] of Longint;
  74.  
  75.     const
  76.         kFokal = 50;            {Lower is more flat. 50 is OK.}
  77.         kStartHeight = 80; {Camera height - should be variable}
  78.  
  79.     procedure Render;
  80.         type
  81.             IntPtr = ^Integer;
  82.         var
  83.             x, y, z: Longint;                {Ray position}
  84.             dx, dz, dy: Longint;        {Ray direction}
  85.             dist, dDist: Integer;        {Number of steps so far}
  86.             screenX, screenY, newscreeny: Integer;    {Pixel coordinates}
  87.             angle: Integer;                    {Ray direction}
  88.             height: Integer;
  89.  
  90.             mapBase, mapTableBase, offBase, rowTableBase: Longint;
  91.             tableP: IntPtr;
  92.             mapP, offP: Ptr;
  93.             Pixel: Byte;
  94.             finish: Integer;
  95.         const
  96.             {q = true;}
  97.             kBackPixValue = 205;
  98.  
  99.         procedure RayStep;
  100.         begin
  101.             tableP := IntPtr(mapTableBase + BSL(BSR(z, kFixedDigits), 2));
  102.             mapP := Ptr(mapBase + tableP^ + BSR(x, kFixedDigits));
  103.             height := mapP^;
  104.  
  105.             height := mapPixels^[mapRowTable[BSR(z, kFixedDigits)] + BSR(x, kFixedDigits)]; {Height of ground}
  106.             if y < height then
  107.                 begin
  108.                     newscreeny := (playerY - height) * kFokal div dist - kHalfRows;    {We could make a table for this, but it would be 2D, i.e. big.}
  109.                     pixel := colorPixels^[mapRowTable[BSR(z, kFixedDigits)] + BSR(x, kFixedDigits)];
  110.  
  111.                     offP := Ptr(offBase + rowTable[screenY] + screenX);
  112.  
  113.                     if newscreeny < 0 then
  114.                         newscreeny := 0;
  115.                     if newscreeny < screenY then
  116.                         begin
  117.  
  118.                             finish := screenY - newscreeny;
  119.                             while finish >= 4 do
  120.                                 begin
  121.                                     offP^ := pixel;
  122.                                     offP := Ptr(Longint(offP) - offscreenRow);
  123.                                     offP^ := pixel;
  124.                                     offP := Ptr(Longint(offP) - offscreenRow);
  125.                                     offP^ := pixel;
  126.                                     offP := Ptr(Longint(offP) - offscreenRow);
  127.                                     offP^ := pixel;
  128.                                     offP := Ptr(Longint(offP) - offscreenRow);
  129.                                     finish := finish - 4;
  130.                                 end;
  131.                             while finish >= 1 do
  132.                                 begin
  133.                                     offP^ := pixel;
  134.                                     offP := Ptr(Longint(offP) - offscreenRow);
  135.                                     finish := finish - 1;
  136.                                 end;
  137.                             screenY := newscreeny;
  138.  
  139.                                         {for screenY := screenY downto newscreeny do}
  140.                                             {begin}
  141.                                                 {offP^ := pixel;}
  142.                                                 {offP := Ptr(Longint(offP) - offscreenRow);}
  143. {Not so good:offscreenPixels^[rowTable[screenY] + screenX] := pixel;}
  144.                                             {end}
  145.                         end
  146.                     else
  147.                         begin {If we get here, something is wrong.}
  148.                         end;
  149. {dy := -screenY * kFixedOne div kFokal; {slope when at screen height screenY!}
  150.                     dy := dyTable[screenY];
  151.                     y := height;
  152.                 end;
  153.  
  154.             dist := dist + dDist;
  155.             x := BAnd(x + dx, kMapMaskFixedH);
  156.             z := BAnd(z + dz, kMapMaskFixedV);
  157.             y := y + dy;
  158.         end; {RayStep}
  159.  
  160.     begin {Render}
  161.         for screenX := 0 to kFullView do
  162.             begin
  163.                 angle := (direction - (screenX - kViewAngle) + kMaxAngle) mod kMaxAngle; {always in interval 0..kMaxAngle}
  164.  
  165. {Double the step to increase speed.}
  166.  
  167.                 screenY := kMaxRows - 1;
  168.                 dist := 1;
  169.                 dDist := 1;
  170.  
  171.                 dx := cosTable[angle];
  172.                 dz := sinTable[angle];
  173.                 dy := dyTable[screenY];
  174.  
  175.                 x := playerX;
  176.                 z := playerZ;
  177.                 y := playerY;
  178.  
  179.                 mapBase := Longint(mapPixels);
  180.                 mapTableBase := Longint(@mapRowTable);
  181.                 offBase := Longint(offscreenPixels);
  182.                 rowTableBase := Longint(@rowTable);
  183.                 repeat
  184.                     RayStep;
  185.                 until (screenY <= 0) or (dist > kMaxRay1);
  186.                 dx := dx * 2;
  187.                 dy := dy * 2;
  188.                 dz := dz * 2;
  189.                 dDist := dDist * 2;
  190.                 repeat
  191.                     RayStep;
  192.                 until (screenY <= 0) or (dist > kMaxRay2);
  193.                 dx := dx * 2;
  194.                 dy := dy * 2;
  195.                 dz := dz * 2;
  196.                 dDist := dDist * 2;
  197.                 repeat
  198.                     RayStep;
  199.                 until (screenY <= 0) or (dist > kMaxRay);
  200.  
  201. {Paint sky!}
  202. {This can be replaced by copying in pixels from a background picture.}
  203.                 if screenY > 0 then
  204.                     begin
  205.                         finish := screenY;
  206.                         while finish >= 4 do
  207.                             begin
  208.                                 offP^ := kBackPixValue;
  209.                                 offP := Ptr(Longint(offP) - offscreenRow);
  210.                                 offP^ := kBackPixValue;
  211.                                 offP := Ptr(Longint(offP) - offscreenRow);
  212.                                 offP^ := kBackPixValue;
  213.                                 offP := Ptr(Longint(offP) - offscreenRow);
  214.                                 offP^ := kBackPixValue;
  215.                                 offP := Ptr(Longint(offP) - offscreenRow);
  216.                                 finish := finish - 4;
  217.                             end;
  218.                         while finish >= 1 do
  219.                             begin
  220.                                 offP^ := kBackPixValue;
  221.                                 offP := Ptr(Longint(offP) - offscreenRow);
  222.                                 finish := finish - 1;
  223.                             end;
  224.                         screenY := 0;
  225.                     end;
  226.                     {for screenY := screenY downto 0 do}
  227.                         {begin}
  228.                             {offscreenPixels^[screenY * offscreenRow + screenX] := kBackPixValue;}
  229.                         {end;}
  230.  
  231.                 if false then
  232.                     begin
  233.                         ForeColor(redColor);
  234.                         MoveTo(BSR(x, kFixedDigits) + 200, BSR(z, kFixedDigits));
  235.                         Line(0, 0);
  236.                         ForeColor(blackColor);
  237.                     end;
  238.  
  239.             end; {for}
  240.  
  241.         SetGWorld(GWorldPtr(w), GetMainDevice);
  242.         ForeColor(blackColor);
  243.         CopyBits(gOffscreen^.portBits, w^.portBits, gOffscreen^.portRect, gOffscreen^.portRect, srcCopy, nil);
  244.  
  245.     end; {Render}
  246.  
  247.  
  248.     procedure InitTables;
  249.         var
  250.             i: Longint;
  251.             v, scale: Longint;
  252.         const
  253.             Pi = 3.1416;
  254.  
  255.         function Round2 (l: Longint): Longint;
  256. {Division by 2 with rounding}
  257.         begin
  258.             if l > 0 then
  259.                 l := l + 1
  260.             else if l < 0 then
  261.                 l := l - 1;
  262.             l := l div 2;
  263.             Round2 := l;
  264.         end;
  265.  
  266.     begin
  267.         for i := 0 to kMaxAngle do
  268.             begin
  269.                 sinTable[i] := Round2(Trunc(kFixedOne * 2 * sin(i * 2 * Pi / kMaxAngle)));
  270.                 cosTable[i] := Round2(Trunc(kFixedOne * 2 * cos(i * 2 * Pi / kMaxAngle)));
  271.             end;
  272.  
  273.         for i := 0 to kMaxRows do
  274.             rowTable[i] := i * offScreenRow;
  275.  
  276.         for i := 0 to kMapSizeV do
  277.             mapRowTable[i] := i * mapRow;
  278.  
  279.         for i := 0 to kMaxRows do
  280.             dyTable[i] := kHalfRows - i * kFixedOne div kFokal;
  281.  
  282.     end; {InitTables}
  283.  
  284.     procedure About;    { Reponse to "About" selection            }
  285.     begin
  286.         if 1 = Alert(128, nil) then ;
  287.     end; {About}
  288.  
  289.     procedure DoFileMenu (item: integer);    { ignored - there's only quit            }
  290.     begin
  291.         case item of
  292.             1: 
  293.                 Render;
  294.             3: 
  295.                 SkelWhoa;            { Tell SkelMain to quit                }
  296.         end; {case}
  297.     end;
  298.  
  299.     procedure Mouse (thePt: Point; t: longint; mods: integer);
  300.     begin
  301.     end;
  302.  
  303.     procedure Idle;
  304.         var
  305.             km: KeyMap;
  306.             i: Integer;
  307.             doRender: Boolean;
  308.     begin
  309. repeat
  310.         doRender := false;
  311.         GetKeys(km);
  312. {Note: Real programs don't use hard-coded key codes (unless they can display the}
  313. {correct keys)!}
  314.         if km[37] then {L}
  315.             begin
  316.                 direction := (direction + kMaxAngle - 20) mod kMaxAngle;
  317.                 doRender := true;
  318.             end;
  319.         if km[38] then {j}
  320.             begin
  321.                 direction := (direction + 20) mod kMaxAngle;
  322.                 doRender := true;
  323.             end;
  324.         if km[34] then {i}
  325.             begin
  326. {Move forward}
  327.                 for i := 1 to 5 do
  328.                     begin
  329.                         playerX := BAnd(playerX + cosTable[direction], kMapMaskFixedH);
  330.                         playerZ := BAnd(playerZ + sinTable[direction], kMapMaskFixedV);
  331.                     end;
  332.                 doRender := true;
  333.             end;
  334.         if km[40] then {k}
  335.             begin
  336. {Reverse}
  337.                 playerX := BAnd(playerX - cosTable[direction], kMapMaskFixedH);
  338.                 playerZ := BAnd(playerZ - sinTable[direction], kMapMaskFixedV);
  339.                 doRender := true;
  340.             end;
  341.  
  342.         if doRender then
  343.             Render;
  344. until not doRender;
  345.     end; {Idle}
  346.  
  347.     procedure Update (resized: Boolean);
  348.     begin
  349.         Render;
  350. {        ForeColor(cyanColor);
  351.         PaintRect(w^.portRect);}
  352.     end; {Update}
  353.  
  354.     procedure Close;
  355.     begin
  356.         SkelWhoa;
  357.     end; {Close}
  358.  
  359.     procedure Key (ch: char; mods: integer);
  360.         var
  361.             i: Integer;
  362.     begin
  363.         {All keyboard handling is done by GetKeys in Idle!}
  364.     end; {Key}
  365.  
  366.     procedure Setup;
  367.         const
  368.             kColorBaseCLUT = 128;
  369.             kGrayCLUT = 129;
  370.             kScreenCLUT = 130;
  371.             kHeightPict = 128;
  372.             kColorPict = 129;
  373.         var
  374.             h, v: Integer;
  375.             clut: CTabHandle;
  376.             savePort: GrafPtr;
  377.             saveDev: GDHandle;
  378.             derivata: Integer;
  379.             heightPict, colorPict: PicHandle;
  380.             palle: PaletteHandle;
  381.     begin
  382.         GetGWorld(GWorldPtr(savePort), saveDev);
  383.  
  384. {Create offscreens}
  385.         SetRect(boundsRect, 0, 0, kViewAngle * 2 + 5, kMaxRows + 10);
  386.  
  387.         clut := GetCTable(kScreenCLUT);
  388. {$IFC UNDEFINED THINK_PASCAL}
  389.         if noErr <> NewGWorld(GWorldPtr(gOffscreen), 8, boundsRect, clut, nil, 0) then
  390. {$ELSEC}
  391.             if noErr <> NewGWorld(GWorldPtr(gOffscreen), 8, boundsRect, clut, nil, []) then
  392. {$ENDC}
  393.                 ExitToShell;
  394.         if LockPixels(CGrafPtr(gOffscreen)^.portPixMap) then
  395.             ;
  396.  
  397.  
  398.         SetRect(mapBoundsRect, 0, 0, kMapSizeH, kMapSizeV);
  399.  
  400. {map is the height field}
  401.         clut := GetCTable(kGrayCLUT);
  402. {$IFC UNDEFINED THINK_PASCAL}
  403.         if noErr <> NewGWorld(GWorldPtr(map), 8, mapBoundsRect, clut, nil, 0) then
  404. {$ELSEC}
  405.             if noErr <> NewGWorld(GWorldPtr(map), 8, mapBoundsRect, clut, nil, []) then
  406. {$ENDC}
  407.                 ExitToShell;
  408.         if LockPixels(CGrafPtr(map)^.portPixMap) then
  409.             ;
  410.  
  411. {colorScreen is the pixel values to display}
  412.         clut := GetCTable(kScreenCLUT);
  413. {$IFC UNDEFINED THINK_PASCAL}
  414.         if noErr <> NewGWorld(GWorldPtr(colorScreen), 8, mapBoundsRect, clut, nil, 0) then
  415. {$ELSEC}
  416.             if noErr <> NewGWorld(GWorldPtr(colorScreen), 8, mapBoundsRect, clut, nil, []) then
  417. {$ENDC}
  418.                 ExitToShell;
  419.         if LockPixels(CGrafPtr(colorScreen)^.portPixMap) then
  420.             ;
  421.  
  422.         offscreenPixels := ByteArrPtr(CGrafPtr(gOffscreen)^.portPixMap^^.baseAddr);
  423.         mapPixels := ByteArrPtr(CGrafPtr(map)^.portPixMap^^.baseAddr);
  424.         colorPixels := ByteArrPtr(CGrafPtr(colorScreen)^.portPixMap^^.baseAddr);
  425.  
  426.         offscreenRow := BitAnd(CGrafPtr(gOffscreen)^.portPixMap^^.rowBytes, $3fff);
  427.         mapRow := BitAnd(CGrafPtr(map)^.portPixMap^^.rowBytes, $3fff);
  428.         colorRow := BitAnd(CGrafPtr(colorScreen)^.portPixMap^^.rowBytes, $3fff);
  429.  
  430.         SetGWorld(GWorldPtr(map), nil);
  431.         heightPict := GetPicture(kHeightPict);
  432.         DrawPicture(heightPict, mapBoundsRect);
  433.  
  434.         colorPict := GetPicture(kColorPict);
  435.         SetGWorld(GWorldPtr(colorScreen), nil);
  436.         DrawPicture(colorPict, mapBoundsRect);
  437.  
  438.         SetGWorld(GWorldPtr(savePort), saveDev);
  439.         clut := GetCTable(kScreenCLUT); {Not currently used}
  440. {SetEntries(0, 256, clut^^.ctTable); {applicerar clut på current device}
  441. {palle := GetNewPalette(128);}
  442. {SetPalette(w, palle, true);}
  443. {AnimatePalette(w, clut, 0, 0, 255);}
  444.  
  445.         CopyBits(map^.portBits, w^.portBits, mapBoundsRect, mapBoundsRect, srcCopy, nil);
  446.         CopyBits(colorScreen^.portBits, w^.portBits, mapBoundsRect, mapBoundsRect, srcCopy, nil);
  447.  
  448.         playerX := 0;
  449.         playerZ := kFixedOne * 30;
  450.         playerY := kStartHeight; {50-80 nånstans?}
  451.         direction := kMaxAngle div 8;
  452.     end;
  453.  
  454. begin
  455.     SkelInit(6, nil);                                        { Initialize                                }
  456.     SkelApple('About Ingemar''s landscape generator…', @About);                                        { Handle Desk Accessories            }
  457.     m := NewMenu(2, 'File');                                { Create Menu                            }
  458.     AppendMenu(m, 'Render/R;(-;Quit/Q');
  459.     dummy := SkelMenu(m, @DoFileMenu, nil, true);    { Tell Transkel to handle it            }
  460.     SkelSetSleep(0);
  461.  
  462.     r.top := 50;
  463.     r.left := 20;
  464.     r.bottom := 300;
  465.     r.right := 450;
  466.     w := GetNewCWindow(130, nil, WindowPtr(-1));
  467.     SetPort(w);
  468.     dummy := SkelWindow(w, @Mouse, @Key, @Update, nil, @Close, nil, @Idle, true);
  469.  
  470.     Setup;
  471.     InitTables;
  472.     SetPort(w);
  473.  
  474.     SkelMain;                                                { loop til quit selected                }
  475.     SkelClobber;                                            { clean up                                }
  476.     DisposeWindow(w);
  477. end.